home *** CD-ROM | disk | FTP | other *** search
/ Fifty: Elektronik / FIFTY Elektronik (PS_Computer_Vertrieb).iso / ps8 / fty1017 / gepackt.exe / DISK2 / PLOTSRC.EXE / STORAGE.INC < prev    next >
Encoding:
Text File  |  1993-11-10  |  6.9 KB  |  316 lines
  1. Procedure DiskErrors(Nr :Integer);
  2. Const ung=' ungülig';
  3.       notfnd =' nicht gefunden';
  4. begin
  5.   Case Abs(Nr) of
  6.    2 :DiskError:='Datei'+notfnd;
  7.    3 :DiskError:='Pfad '+notfnd;
  8.    4 :DiskError:='zuviele offene Dateien';
  9.    5 :DiskError:='Dateizugriff verweigert/ Directory voll';
  10.    6 :DiskError:='Datei-Handle'+ung;
  11.    12:DiskError:='Dateimodus'+ung;
  12.    15:DiskError:='Laufwerksangabe'+ung;
  13.    16:DiskError:='aktuelles Verzeichnis nicht entfernbar';
  14.    17:DiskError:='Rename kann nicht kopieren';
  15.    100:DiskError:='Lesefehler';
  16.    101:DiskError:='Schreibfehler/Diskette voll';
  17.    102:DiskError:='Datei nicht zugeordnet';
  18.    103:DiskError:='Datei nicht offen';
  19.    104:DiskError:='Datei nur zum Lesen offen';
  20.    105:DiskError:='Datei nur zum Schreiben offen';
  21.    106:DiskError:='Ungültiges Zahlenformat';
  22.    150:DiskError:='Schreibschutz';
  23.    151:DiskError:='unbek. Dev.';
  24.    152:DiskError:='Laufwerk nicht bereit';
  25.    153:DiskError:='Unbek. DOS-Fkt.';
  26.    154:DiskError:='CRC-Fehler/ schlechte Diskette';
  27.    155:DiskError:='unglt. DPB';
  28.    156:DiskError:='Kopf-Positionierfehler';
  29.    157:DiskError:='unbek. Sektorformat';
  30.    158:DiskError:='Sektor'+notfnd;
  31.    -1..
  32.    -10:DiskError:='Stream-I/O-Fehler';
  33.    else DiskError:='unbek. Disk-Fehler';
  34.  end;
  35.  If Nr>=0 then Write(DiskError);
  36. end;
  37.  
  38. Procedure PromptError;
  39. Var TC :Char;
  40. begin
  41.   ErrorInit;
  42.   DiskErrors(IOStatus);
  43.   Select('  Abbruch (J/N) ?',['J','N',Esc],TC);
  44.   If TC='J' then StIOCheck(0);
  45. end;
  46.  
  47.  
  48. (*$I-*)
  49.  
  50. Function GenugMem:Boolean;
  51. Begin
  52.   GenugMem:=Maxavail>GenugRAM;
  53. End;
  54.  
  55.  
  56. Procedure StIoCheck(K:Word);
  57. Begin
  58.   OK:=IoStatus=0;
  59.   If Not(Ok) Then
  60.     begin
  61.       If GrafmodeGlb then TextMode;
  62.       ClrScr;
  63.       GotoXY(1,1);
  64.       Writeln('Fataler Ein/Ausgabe-Fehler : ');
  65.       If K>0 Then Writeln('Objekt-Nummer : ',K);
  66.       Writeln;DiskErrors(IoStatus);
  67.       Writeln;
  68.       Writeln('Weiter : Irgendeine Taste');
  69.       Waitonkey;
  70.       Halt;
  71.     End;
  72. End;
  73.  
  74. Function OpenError:Boolean;
  75. Var Result :Boolean;
  76. begin
  77.   Result:=false;
  78.   If Not(Ok) then
  79.   begin
  80.     Result:=true;
  81.     Case IoStatus of
  82.       2,3: Result:=false; {Datei/Path nicht gefunden}
  83.       5,150,152  :PromptError;
  84.       {5   =Dir voll/Schreibschutz }
  85.       {150 =Schreibschutz}
  86.       {152 =Drive not Ready }
  87.       else StIOCheck(0);
  88.      end;
  89.   end;
  90.   OpenError:=Result;
  91. end;
  92.  
  93. procedure OpenFile(var DatF   : DataFile; FName  : Str64);
  94. begin
  95.   Inc(No_blink,1); { Disable Blinken }
  96.   Assign(DatF,FName);
  97.   IOstatus := IOresult;
  98.   StIOcheck(0);
  99.   Repeat
  100.     Reset(DatF,Sizeof(Bildelement));
  101.     IOstatus := IOresult;
  102.     OK:=(IoStatus=0);
  103.   until (Iostatus=5) or Not(Openerror);
  104.   Dec(No_blink,1); { Enable Blinken }
  105. end;
  106.  
  107.  
  108. procedure MakeFile(var DatF   : DataFile; FName  : Str64);
  109. begin
  110.   Inc(No_blink,1); { Disable Blinken }
  111.   Assign(DatF,FName);
  112.   IOstatus := IOresult;
  113.   StIOcheck(0);
  114.   Repeat
  115.     Rewrite(DatF,Sizeof(Bildelement));
  116.     IOstatus := IOresult;
  117.     OK := IOstatus=0;
  118.   Until Not(OpenError);
  119.   Dec(No_blink,1); { Enable Blinken }
  120. end;
  121.  
  122.  
  123. procedure CloseFile(var DatF : DataFile);
  124.  
  125. begin
  126.   Inc(No_blink,1); { Disable Blinken }
  127.   Close(DatF);
  128.   IOstatus := IOresult;
  129.   Iostatus:=0;
  130.   Dec(No_blink,1); { Enable Blinken }
  131. end;
  132.  
  133.  
  134. Function UsedRecs(var DatF : DataFile):Longint;
  135.  
  136. begin
  137.   Inc(No_blink,1); { Disable Blinken }
  138.   UsedRecs:=FileSize(DatF);
  139.   IOstatus := IOresult;
  140.   StIOcheck(65535);
  141.   Dec(No_blink,1); { Enable Blinken }
  142. end;
  143.  
  144.  
  145. Procedure OpenEXT;
  146. begin
  147.   Inc(No_blink,1); { Disable Blinken }
  148.   TMP:=nil;
  149.   If MaxAvail>5*Sizeof(TTmpStream) then
  150.     TMP:=New(PtmpStream,
  151.              Init(Longint(Stackzeiger)*Sizeof(Bildelement),'.$LD'));
  152.   IoStatus:=$FFFF;
  153.   If tmp<>nil then
  154.     IoStatus:=Tmp^.Status;
  155.   Dec(No_blink,1); { Enable Blinken }
  156. end;
  157.  
  158.  
  159. Procedure CloseEXT;
  160. begin
  161.   If TMP<>nil Then
  162.      Begin
  163.        Inc(No_blink,1); { Disable Blinken }
  164.        Dispose(TMP,done);
  165.        Dec(No_blink,1); { Enable Blinken }
  166.      End;
  167.  
  168. end;
  169.  
  170. Procedure CheckRamdiskPath;
  171. Var Drive:Char;
  172. Begin
  173.   Inc(No_blink,1); { Disable Blinken }
  174.   With SetupInfo Do
  175.     If LastTMPDrive<>'' then
  176.      begin
  177.        Drive:=Upcase(LastTMPDrive[1]);
  178.        If (Drive>='C') and (Drive<'Z') then LastTMPDrive:=Drive;
  179.      end;
  180.    Dec(No_blink,1); { Enable Blinken }
  181. End;
  182.  
  183.  
  184. Procedure InitStorage;
  185. Begin
  186.   FillChar(RecordStack,Sizeof(RecordStack),0);
  187.   StackZeiger:=0;
  188.   NmaxMem:=0;
  189.   FirstFree:=65535;
  190.   TMP:=nil;
  191.   CheckRamDiskpath;
  192.   StackMin:=1;
  193.   Ok:=True;
  194. End;
  195.  
  196.  
  197. Procedure EndStorage;
  198. Var I :Word;
  199.  
  200. Begin
  201.    For I:=0 to Hi(NmaxMem) do
  202.      If RecordStack[I]<>nil then
  203.       begin
  204.         Dispose(RecordStack[I]);
  205.         RecordStack[I]:=nil;
  206.       end;
  207.   CloseEXT;
  208. end;
  209.  
  210. Procedure ResetStack(K :Word);
  211.  
  212. Begin
  213.   If K<NmaxMem Then
  214.     If TMP<>nil Then
  215.       begin
  216.        Dispose(TMP,Done);
  217.        TMP:=nil;
  218.       end;
  219.   StackZeiger:=K;
  220. End;
  221.  
  222.  
  223. Procedure GetRec(Var Obj :Bildelement;K :Word);
  224.  
  225. Begin
  226.   Ok:=true;
  227.   If K<=NmaxMem Then
  228.     begin
  229.      Dec(K,1);
  230.      Obj:=RecordStack[Hi(K)]^ [Lo(K)]
  231.     End
  232.   else
  233.     Begin
  234.       Inc(No_blink,1); { Disable Blinken }
  235.       TMP^.Seek(Longint(K-NmaxMem-1)*Sizeof(Bildelement));
  236.       Ok:=TMP^.Status=0;
  237.       TMP^.Read(Obj,Sizeof(Bildelement));
  238.       Ok:=(TMP^.Status=0) and Ok;
  239.       Dec(No_blink,1); { Enable Blinken }
  240.     End;
  241. End;
  242.  
  243.  
  244. Procedure PutRec(Obj :Bildelement;K :Word);
  245. Var TmpFile :Datafile;
  246.     Buf     :Bildelement;
  247. Begin
  248.   Ok:=true;
  249.   DWG_modified:=true;
  250.   If K<=NmaxMem Then
  251.      begin
  252.        Dec(K,1);
  253.        RecordStack[Hi(K)]^ [Lo(K)]:=Obj;
  254.      end
  255.   else
  256.     Begin
  257.       Inc(No_blink,1); { Disable Blinken }
  258.       TMP^.Seek(Longint(K-NmaxMem-1)*Sizeof(Bildelement));
  259.       Ok:=TMP^.Status=0;
  260.       If Ok then
  261.          begin
  262.           TMP^.Write(Obj,Sizeof(Bildelement));
  263.           Ok:=(TMP^.Status=0);
  264.          end;
  265.       IoStatus:=TMP^.Status;
  266.       StIoCheck(K);
  267.       Dec(No_blink,1); { Enable Blinken }
  268.     End;
  269. End;
  270.  
  271.  
  272. Procedure AddRec(Obj : Bildelement; Var K :Word);
  273.  
  274. Var Ob1      :Bildelement;
  275.     BlockNr  : Word;
  276. Begin
  277.   Ok:=true;
  278.   If (FirstFree<= StackZeiger) and (FirstFree>=StackMin) Then
  279.         Begin
  280.           GetRec(Ob1,FirstFree);
  281.           Obj.Status:=0;
  282.           PutRec(Obj,FirstFree);
  283.           K:=FirstFree;
  284.           FirstFree:=Ob1.Status;
  285.         End
  286.   else
  287.     begin (* Neuer Record *)
  288.       Inc(StackZeiger,1);
  289.       K:=StackZeiger;
  290.       If (StackZeiger > NmaxMem) and (TMP=nil) Then
  291.          If GenugMem Then
  292.            begin
  293.              BlockNr:=Hi(Pred(StackZeiger));
  294.              New(RecordStack[BlockNr]);
  295.              Inc(NmaxMem,256);
  296.            End
  297.          Else OpenEXT;
  298.       Obj.Status:=0;
  299.       PutRec(Obj,StackZeiger);
  300.     end;
  301. End;
  302. (*$I+*)
  303.  
  304.  
  305. Procedure DeleteRec(Var Obj: Bildelement;K: Word);
  306.  
  307. Var Stat: Word;
  308. Begin
  309.   GetRec(Obj,K);
  310.   Stat:=Obj.Status;
  311.   Obj.Status:=FirstFree;
  312.   PutRec(Obj,K);
  313.   FirstFree:=K;
  314.   Obj.Status:=Stat;
  315. End;
  316.